home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / misc~1 / 4 / cribbage.bas < prev    next >
Encoding:
BASIC Source File  |  1986-03-06  |  20.9 KB  |  670 lines
  1. 1     rem Copyright 1985 by Martin Consulting
  2. 10    muggins$="yes"
  3. 20    fullw 2:clearw 2:gosub init:goto start
  4. 30    ERRSOUND:sound 1,8,12,4,2:sound 1,0,0,0,0:return
  5. 40    PBOX:'entry
  6. 50    poke contrl,11
  7. 60    poke contrl+2,2
  8. 70    poke contrl+6,0
  9. 80    poke contrl+10,1
  10. 90    poke ptsin,x
  11. 100   poke ptsin+2,y+20
  12. 110   poke ptsin+4,x+wd
  13. 120   poke ptsin+6,y+ht+20
  14. 130   vdisys(1)
  15. 140   return
  16. 150   MOUSE:a#=gb
  17. 160   gintout=peek(a#+12)
  18. 170   poke systab+24,1
  19. 180   poke contrl,122:poke contrl+2,0:poke contrl+6,1
  20. 190   poke intin,0:vdisys(1)
  21. 200   gemsys(79)
  22. 210   x=peek(gintout+2)
  23. 220   y=peek(gintout+4)-20
  24. 230   key=peek(gintout+6):poke systab+24,0:return
  25. 240   if key=2 then poke systab+24,0:return
  26. 250   if key=1 then poke systab+24,0:return
  27. 260   goto 200
  28. 270   BOXOUT: sx=x:sy=y:sht=ht:swd=wd:color 1,1,1,1,1:gosub pbox:x=x+1:y=y+1
  29. 280   ht=ht-2:wd=wd-2:color 1,0,1,1,1:gosub pbox:x=sx:y=sy:ht=sht:wd=swd
  30. 290   return
  31. 300   CARD: num$=right$(num$,1):if num=10 then num$="10"
  32. 310   ht=45:wd=30:gosub boxout:gotoxy (x/9)+1,(y/9):?num$
  33. 320   if num=10 then ninc=2 else ninc=3
  34. 330   gotoxy (x/9)+ninc,(y/9)+4:? num$
  35. 340   on num goto one,two,three,four,five,six,seven,eight,nine,ten,jack,           queen,king
  36. 350   ONE: x=sx+10:y=sy+17:gosub suitprt:return
  37. 360   TWO: x=sx+1:y=sy+8:gosub suitprt:x=sx+19:y=sy+26:gosub suitprt:return
  38. 370   THREE: gosub one:gosub two:return
  39. 380   FOUR: gosub two:x=sx+19:y=sy+8:gosub suitprt:x=sx+1:y=sy+26:gosub suitprt:   return
  40. 390   FIVE: gosub four:gosub one:return
  41. 400   SIX: gosub four:x=sx+10:y=sy+8:gosub suitprt:y=sy+26:gosub suitprt:return
  42. 410   SEVEN: gosub six:gosub one:return
  43. 420   EIGHT: gosub six: x=sx+1:y=sy+17:gosub suitprt:x=sx+19:gosub suitprt:return
  44. 430   NINE: gosub eight:gosub one:return
  45. 440   TEN: gosub eight:x=sx+19:y=sy-1:gosub suitprt:x=sx+1:y=sy+35:gosub suitprt:  return
  46. 450   JACK:gosub corners:x=sx+1:y=sy-2:color 1,14,14,1,2:pcircle x+13,y+10,4:      ellipse x+4,y+21,2,9:color 1,7,7,17,2:pellipse x+13,y+6,5,2
  47. 460   pellipse x+13,y+43,3,13,0,1800:color 1,2,2,24,2:pellipse x+13,y+32,6,       18,0,1800:pellipse x+5,y+19,11,2,2700,900:return
  48. 470   QUEEN:gosub corners:x=sx+1:y=sy-2:color 1,14,14,1,2:pcircle x+13,y+13,4:color 1,7,7,17,2:pellipse x+13,y+9,6,2:color 1,13,13,16,2:pellipse x+13,y+7,5,3
  49. 480   color 1,5,5,17,2:pellipse x+13,y+34,12,18,0,1800:color 1,12,2,3,2
  50. 490   pellipse x+13,y+44,4,24,0,1800:linef x+11,y+14,x+15,y+15:linef              x+12,y+16,x+14,y+16:color 1,4,4,1,1:linef x+11,y+12,x+11,y+12
  51. 500   linef x+15,y+11,x+15,y+15:color 1,6,6,1,1:pellipse x+9,y+10,2,10,1800,0
  52. 510   pellipse x+20,y+10,2,10,1800,0:return
  53. 520   KING:gosub corners:x=sx+1:y=sy-2:color 1,14,14,1,2:pcircle x+13,y+13,4:color 1,11,7,17,2:pellipse x+13,y+9,5,2:color 1,2,2,16,2:pellipse x+13,y+7,5,3
  54. 530   color 1,7,7,17,2:pellipse x+13,y+34,12,18,0,1800:color 1,12,2,3,2
  55. 540   pellipse x+13,y+44,4,24,0,1800:linef x+11,y+14,x+15,y+15:linef              x+12,y+16,x+14,y+16:color 1,4,4,1,1:linef x+11,y+12,x+11,y+12
  56. 550   linef x+15,y+11,x+15,y+15:pellipse x+3,y+35,3,24,0,1800:pellipse             x+25,y+35,3,24,0,1800:return
  57. 560   CORNERS: x=sx+18:y=sy:gosub suitprt:x=sx:y=sy+34:gosub suitprt:return
  58. 570   SUITPRT: on suit goto club,diamond,heart,spade
  59. 580   CLUB: color 1,1,1,1,1
  60. 590   linef x+4,y,x+4,y+8:linef x+3,y,x+3,y+5:linef x+5,y,x+5,y+5
  61. 600   linef x,y+4,x+8,y+4:linef x,y+5,x+8,y+5:linef x,y+3,x+1,y+3:linef            x,y+6,x+1,y+6:linef x+7,y+3,x+8,y+3
  62. 610   linef x+2,y,x+2,y+1:linef x+7,y+6,x+8,y+6:linef x+6,y,x+6,y+1
  63. 620   return
  64. 630   SPADE: color 1,1,1,1,1
  65. 640   linef x+1,y+3,x+1,y+6:linef x+2,y+2,x+2,y+6:linef x+3,y+1,x+3,y+5
  66. 650   linef x+4,y,x+4,y+8:linef x+5,y+1,x+5,y+5:linef x+6,y+2,x+6,y+6
  67. 660   linef x+7,y+3,x+7,y+6
  68. 670   return
  69. 680   HEART: color 1,2,2,1,1
  70. 690   linef x,y+2,x,y+4:linef x+1,y+1,x+1,y+5:linef x+2,y+1,x+2,y+6
  71. 700   linef x+3,y+2,x+3,y+7:linef x+4,y+3,x+4,y+8:linef x+5,y+2,x+5,y+7
  72. 710   linef x+6,y+1,x+6,y+6:linef x+7,y+1,x+7,y+5:linef x+8,y+2,x+8,y+4
  73. 720   return
  74. 730   DIAMOND: color 1,2,2,1,1
  75. 740   linef x+4,y,x,y+4:linef x,y+4,x+4,y+8:linef x+4,y+8,x+8,y+4
  76. 750   linef x+8,y+4,x+4,y:fill x+4,y+4
  77. 760   return
  78. 770   BACK: ht=45:wd=30:color 1,4,1,16,2:color 1,4,1,16,2:gosub pbox:return
  79. 780   CLRINST:gotoxy 8,0:?spc(32):gotoxy 8,0:return
  80. 790   CLRBD:x=10:y=12:ht=144:wd=295:color 1,0,1,1,1:gosub pbox:gosub pointup:return
  81. 800   PAUSE:color 2,0,1,1,1:gotoxy 20,17:?"Push RT button";
  82. 810   gosub mouse:if key<>2 then 810
  83. 820   gotoxy 20,17:?spc(14);:color 1,0,1,1,1:return
  84. 830   CRIBPRT:x=16+crib:y=60:crib=crib+2:gosub back:return
  85. 840   GETPLAY: goget=0:i=0
  86. 850   gosub mouse:if key<>1 goto 850
  87. 860   if y>70 and y< 88 and x>60 and x<87 then goget=1:return
  88. 870   if y<158 then goto 850
  89. 880   if x>16 and x<46 then i=1:return
  90. 890   if x>52 and x<82 then i=2:return
  91. 900   if x>88 and x<118 then i=3:return
  92. 910   if x>124 and x<154 then i=4:return
  93. 920   if x>160 and x<190 then i=5:return
  94. 930   if x>196 and x<226 then i=6:return
  95. 940   goto 850
  96. 950   PLAYERA: ht=45:wd=35:color 1,0,1,1,1:x=16+((i-1)*36)
  97. 960   if y<>12 then y=111
  98. 970   gosub pbox:return
  99. 980   COMPLAY: comnum=comnum+1:x=223+(comnum*9):y=3+(comnum*9):gosub              card:return
  100. 990   HUMPLAY: humnum=humnum+1:x=223+(humnum*9):y=66+(humnum*9):gosub             card:return
  101. 1000  GOBOX: cl=1
  102. 1010  GOPRT:ht=18:wd=27:x=60:y=70:color 1,cl,1,1,1:gosub pbox:ht=ht-8
  103. 1020  wd=wd-8:x=x+4:y=y+4:color 1,0,1,1,1:gosub pbox:gotoxy 7,8:?"GO":return
  104. 1030  SPREAD:y=63
  105. 1040  for x=14 to 274 step 5:if x>137 then y=y+1 else y=y-1
  106. 1050  gosub back:next:return
  107. 1060  GETSPREAD: gosub mouse:if key<>1 goto 1060
  108. 1070  if x<14 or x>303 goto 1060
  109. 1080  if y>120 or y<82 goto 1060
  110. 1090  cardnum=int ((x-7)/5):return
  111. 1100  CARDSPLIT:num$=left$(c$,2):suit$=mid$(c$,7,1)
  112. 1110  if suit$="C" then suit=1 else if suit$="D" then suit=2 else if suit$=       "H" then suit=3 else if suit$="S" then suit=4
  113. 1120  if num$=" A" then num=1:return
  114. 1130  if num$=" J" then num=11:return
  115. 1140  if num$=" Q" then num=12:return
  116. 1150  if num$=" K" then num=13:return
  117. 1160  if num$="10" then num=10:return
  118. 1170  num=val(right$(num$,1)):return
  119. 1180  POINTUP:gotoxy 21,8:?s1:gotoxy 21,10:?s2
  120. 1190  gotoxy 20,7:?"POINTS":gotoxy 20,8:?"C:":gotoxy 20,10:?"P:":return
  121. 1200  START:S1 = 0: S2 = 0
  122. 1210  gosub shuffle
  123. 1220  gosub cut
  124. 1230  gosub shuffle
  125. 1240  gosub deal
  126. 1250  gosub clrinst:?"I'm thinking.":gosub best4
  127. 1260  lp=1:rem computer"order of play"
  128. 1270  cp(lp)=0:lp=lp+1:if lp<7 goto 1270
  129. 1280  for lp=1 to 6
  130. 1290  xx=int(rnd*6)+1
  131. 1300  for l2=1 to 6: if xx=cp(l2) then 1290
  132. 1310  next l2:cp(lp)=xx:next
  133. 1320  y=12:i=cp(1):gosub playera:gosub cribprt:i=cp(2):y=12:gosub playera:        gosub cribprt:cp=2
  134. 1330  I1 = V(B9,5):i2=v(b9,6)
  135. 1340  rem player discards
  136. 1350  rpt=0:i3=0:i4=0
  137. 1360  gosub clrinst:?"Discard:click under card."
  138. 1370  gosub getplay:if i=i3 goto 1360
  139. 1380  if goget=1 goto 1360
  140. 1390  gosub playera:gosub cribprt:rpt=rpt+1
  141. 1400  if rpt=1 then i3=i:goto 1360
  142. 1410  if rpt=2 then i4=i:gosub playera:gosub cribprt
  143. 1420  REM  ** CRIB
  144. 1430  j=1
  145. 1440  C(1,J) = M(I1,J)
  146. 1450  C(2,J) = M(I2,J)
  147. 1460  C(3,J) = Y(I3,J)
  148. 1470  C(4,J) = Y(I4,J)
  149. 1480  j=j+1:if j<5 goto 1440
  150. 1490  gosub upcard
  151. 1500  gosub play
  152. 1510  IF M = 0 THEN 1550
  153. 1520  gosub clrinst:?"You meld first.":gosub pause
  154. 1530  X1 = 1
  155. 1540  GOTO 1730
  156. 1550  gosub clrinst:?"I meld first.":gosub pause
  157. 1560  X1 = 2
  158. 1570  GOTO 1970
  159. 1580  ht=45:wd=38:x=16:y=60:color 1,0,1,1,1:gosub pbox:for i=1 to 4:rem crib disp
  160. 1590  c$=c$(c(i,1)):gosub cardsplit:y=57:x=16+((i-1)*18):gosub card:next i
  161. 1600  FOR I = 1 TO 4: FOR J = 1 TO 4
  162. 1610  W(I,J) = C(I,J)
  163. 1620  NEXT J: NEXT I
  164. 1630  C = 1
  165. 1640  W(5,4) = T9
  166. 1650  gosub scorehand
  167. 1660  ON X1 GOTO 1670,1710
  168. 1670  gosub clrinst:PRINT P;"points.":gosub pause
  169. 1680  S1 = S1+P:gosub pointup
  170. 1690  IF S1 >= 121 THEN 2160
  171. 1700  GOTO 2140
  172. 1710  X1 = 3
  173. 1720  GOTO 1840
  174. 1730  K = 1
  175. 1740  i=1
  176. 1750  IF I = I3 THEN 1800
  177. 1760  IF I = I4 THEN 1800
  178. 1770  j=1
  179. 1780  w(k,j)=y(i,j):j=j+1:if j<5 goto 1780
  180. 1790  K = K + 1
  181. 1800  i=i+1:if i<7 goto 1750
  182. 1810  W(5,4) = T9
  183. 1820  C = 0
  184. 1830  gosub scorehand
  185. 1840  gosub clrinst:print "How many points ";
  186. 1850  INPUT P9
  187. 1860  D = P-P9
  188. 1870  IF D >= 0 THEN 1900
  189. 1880  gosub clrinst:PRINT "Not with that hand!":gosub pause
  190. 1890  GOTO 1840
  191. 1900  S2 = S2+P9:gosub pointup
  192. 1910  IF S2 >= 121 THEN 2170
  193. 1920  IF D = 0 or muggins$<>"yes" goto 1960
  194. 1930  S1 = S1+D:gosub pointup
  195. 1940  gosub clrinst:?"Muggins for";D;"points.":gosub pause
  196. 1950  IF S1 >= 121 THEN 2160
  197. 1960  ON X1 GOTO 1970,1580,2140
  198. 1970  FOR K = 1 TO 4
  199. 1980  L = V(B9,K)
  200. 1990  j=1
  201. 2000  w(k,j)=m(l,j):j=j+1:if j<5 goto 2000
  202. 2010  NEXT K
  203. 2020  rem computer shows cards
  204. 2030  for k=1 to 4: if k+2<= cp goto 2060
  205. 2040  l=w(k,1):c$=c$(l):gosub cardsplit:i=cp(k+2):y=13
  206. 2050  x=16+((i-1)*36):gosub card
  207. 2060  next k
  208. 2070  W(5,4) = T9
  209. 2080  C = 0
  210. 2090  gosub scorehand
  211. 2100  S1 = S1 +P:gosub pointup
  212. 2110  if s1>121 then 2160
  213. 2120  gosub clrinst:? P;"points"
  214. 2130  ON X1 GOTO 1580,1730
  215. 2140  gosub pointup
  216. 2150  GOTO 1230
  217. 2160  gosub clrinst:?"I win";S1;" to";S2:gosub pause:stop
  218. 2170  gosub clrinst:?"You win";S2;"to";S1:gosub pause:stop
  219. 2180  PLAY:
  220. 2190  Y5 = 0: M5 = 0: C = 0: S9 = 0: G = 0
  221. 2200  IF M = 0 THEN 2560
  222. 2210  IF Y5 <> 4 THEN 2240
  223. 2220  IF M5 = 4 THEN 3140
  224. 2230  GOTO 2560
  225. 2240  gosub clrinst:?"Play:click under card or GO"
  226. 2250  gosub getplay:if goget=1 then c$="go" else c$=""
  227. 2260  if c$ = "go" then 2560
  228. 2270  c6=i
  229. 2280  IF C6 = I3 THEN 2500
  230. 2290  IF C6 = I4 THEN 2500
  231. 2300  IF Y5 = 0 THEN 2340
  232. 2310  j=1
  233. 2320  IF I(10+J) = C6 THEN 2520
  234. 2330  j=j+1:if j<(y5+1) goto 2320
  235. 2340  IF S9+Y(C6,2) > 31 THEN 2540
  236. 2350  S9 = S9+ Y(C6,2)
  237. 2360  Y5 = Y5 + 1
  238. 2370  I(10+Y5) = C6
  239. 2380  C = C+1
  240. 2390  J(C) = Y(C6,4)
  241. 2400  gosub checkhand
  242. 2410  c$=c$(y(c6,1)):gosub cardsplit:i=c6:gosub playera:gosub humplay
  243. 2420  gosub clrinst:PRINT "Sum =";: PRINT USING "##";S9;
  244. 2430  PRINT ", Points = ";: PRINT USING "###";P:gosub pause
  245. 2440  F = 1
  246. 2450  S2 = S2 + P:gosub pointup
  247. 2460  IF S2 > 121 THEN 2170
  248. 2470  IF S9 <> 31 THEN 2560
  249. 2480  F = 0: C = 0: S9 = 0: G = 0
  250. 2490  GOTO 2560
  251. 2500  gosub clrinst:?"You discarded that card.":gosub errsound:gosub pause
  252. 2510  GOTO 2240
  253. 2520  gosub clrinst:?" Already played":gosub errsound:gosub pause
  254. 2530  GOTO 2240
  255. 2540  gosub clrinst:?"That totals more than 31":gosub errsound:gosub pause
  256. 2550  GOTO 2240
  257. 2560  IF M5 <> 4 THEN 2700
  258. 2570  IF Y5 = 4 THEN 3140
  259. 2580  IF C$ <> "go" THEN 2210
  260. 2590  IF F = 2 THEN 2650
  261. 2600  gosub clrinst:?"You get 1 point for last card.":gosub pause
  262. 2610  S2 = S2+1:gosub pointup
  263. 2620  IF S2 >= 121 THEN 2170
  264. 2630  f=0:c=0:s9=0
  265. 2640  GOTO 2210
  266. 2650  gosub clrinst:?"I get 1 point for last card.":gosub pause
  267. 2660  S1 = S1+1:gosub pointup
  268. 2670  IF S1 >= 121 THEN 2160
  269. 2680  F = 0: C = 0: S9 = 0
  270. 2690  GOTO 2210
  271. 2700  K9 = 0: P9 = 0
  272. 2710  C9 = C
  273. 2720  C = C+1
  274. 2730  H9 = S9
  275. 2740  FOR I9 = 1 TO 6
  276. 2750  I(I9) = 0
  277. 2760  IF I9 = I1 THEN 2900
  278. 2770  IF I9 = I2 THEN 2900
  279. 2780  IF M5 = 0 THEN 2820
  280. 2790  FOR J9 = 1 TO M5
  281. 2800  IF I9 = I(20+J9) THEN 2900
  282. 2810  NEXT J9
  283. 2820  IF H9+M(I9,2) > 31 THEN 2900
  284. 2830  K9 = K9 + 1
  285. 2840  S9 = H9 + M(I9,2)
  286. 2850  J(C) = M(I9,4)
  287. 2860  GOSUB 3580
  288. 2870  IF P > P9 THEN P9 = P
  289. 2880  I(I9) = P
  290. 2890  I(K9+30) = I9
  291. 2900  NEXT I9
  292. 2910  C = C9
  293. 2920  S9 = H9
  294. 2930  IF K9 <> 0 THEN 3240
  295. 2940  IF c$ <> "go" THEN 3010
  296. 2950  IF G = 1 THEN 3020
  297. 2960  gosub clrinst:?"1 point to me for last card":gosub pause
  298. 2970  C = 0: S9 = 0
  299. 2980  S1 = S1+1:gosub pointup
  300. 2990  IF S1> 121 THEN 2160
  301. 3000  GOTO 2210
  302. 3010  IF Y5 <> 4 THEN 3080
  303. 3020  gosub clrinst:?"1 point to you for last card":gosub pause
  304. 3030  S2 = S2+1:gosub pointup
  305. 3040  IF S2 >= 121 THEN 2170
  306. 3050  C = 0: S9 = 0: G = 0
  307. 3060  C$ = ""
  308. 3070  GOTO 2560
  309. 3080  IF G = 1 THEN 2210
  310. 3090  gosub clrinst:?"Go"
  311. 3100  gosub mouse:if key=2 goto 3100
  312. 3110  gosub pause
  313. 3120  G = 1
  314. 3130  GOTO 2210
  315. 3140  IF F = 0 THEN 3230
  316. 3150  IF F = 1 THEN 3200
  317. 3160  gosub clrinst:?"1 for me--last card":gosub pause
  318. 3170  S1 = S1 +1:gosub pointup
  319. 3180  IF S1 > 121 THEN 2160
  320. 3190  GOTO 3230
  321. 3200  gosub clrinst:?"1 for you--last card":gosub pause
  322. 3210  S2 = S2 + 1:gosub pointup
  323. 3220  IF S2 >= 121 THEN 2170
  324. 3230  gosub pointup:return
  325. 3240  C = C + 1
  326. 3250  M5 = M5 + 1
  327. 3260  IF C <> 1 THEN 3380
  328. 3270  j9=1
  329. 3280  I9 = V(B9,J9)
  330. 3290  IF M(I9,2) = 5 THEN 3350
  331. 3300  I(M5+20) = I9
  332. 3310  J(C) = M(I9,4)
  333. 3320  P9 = 0
  334. 3330  S9 = M(I9,2)
  335. 3340  GOTO 3460
  336. 3350  j9=j9+1:if j9<5 goto 3280
  337. 3360  L = V(B9,1)
  338. 3370  GOTO 3300
  339. 3380  j9=1
  340. 3390  I9 = I(J9+30)
  341. 3400  IF I(I9) = P9 THEN 3420
  342. 3410  j9=j9+1:if j9<(k9+1) goto 3390
  343. 3420  I(M5+20) = I9
  344. 3430  J(C) = M(I9,4)
  345. 3440  S9 = S9 + M(I9,2)
  346. 3450  rem computer plays
  347. 3460  c$=c$(m(i9,1)):gosub cardsplit
  348. 3470  cp=cp+1:i=cp(cp):y=12:gosub playera:gosub complay
  349. 3480  gosub clrinst:?"Sum =";: PRINT USING"##";S9;
  350. 3490  print ", Points =";:print using "###";p9:gosub pause
  351. 3500  F = 2
  352. 3510  S1 = S1 + P9:gosub pointup
  353. 3520  IF S1 > 121 THEN 2160
  354. 3530  IF S9 <> 31 THEN 3560
  355. 3540  F = 0: C = 0: S9 = 0
  356. 3550  GOTO 2210
  357. 3560  IF C$ = "go" OR C$ = "GO" THEN 2560
  358. 3570  GOTO 2210
  359. 3580  CHECKHAND:p=0:if c=1 goto 3800
  360. 3590  IF S9 <> 15 THEN 3620
  361. 3600  P = P + 2
  362. 3610  GOTO 3650
  363. 3620  IF S9 <> 31 THEN 3650
  364. 3630  P = P + 2
  365. 3640  UY = 2: IF C - 2 > 2 THEN UY = C-2
  366. 3650  FOR I = C TO UY STEP -1
  367. 3660  IF J(I) <> J(I-1) THEN 3740
  368. 3670  ON C-I+1 GOTO 3680,3700,3720
  369. 3680  P = P+ 2
  370. 3690  GOTO 3730
  371. 3700  P = P+4
  372. 3710  GOTO 3730
  373. 3720  P = P + 6
  374. 3730  NEXT I
  375. 3740  IF C = 2 goto 3800
  376. 3750  R9 = 0
  377. 3760  i=3
  378. 3770  GOSUB 3810
  379. 3780  i=i+1:if i<(c+1) goto 3770
  380. 3790  P = P + R9
  381. 3800  RETURN
  382. 3810  j=1
  383. 3820  J(J+10) = J(C-J+1)
  384. 3830  j=j+1:if j<(c+1) goto 3820
  385. 3840  FOR K = 1 TO I
  386. 3850  FOR L = K + 1 TO I
  387. 3860  IF J(K+10) < J(L+10) goto 3900
  388. 3870  X = J(K+10)
  389. 3880  J(K+10) = J(L+10)
  390. 3890  J(L+10) = X
  391. 3900  NEXT L
  392. 3910  NEXT K
  393. 3920  k=1
  394. 3930  IF J(K+10) <> J(K+11)-1 goto 3960
  395. 3940  k=k+1:if k<i goto 3930
  396. 3950  R9 = I
  397. 3960  RETURN
  398. 3970  BEST4:p9=0:for x9=1 to 15
  399. 3980  I1 = V(Z9,1)
  400. 3990  I2 = V(Z9,2)
  401. 4000  I3 = V(Z9,3)
  402. 4010  I4 = V(Z9,4)
  403. 4020  j=1
  404. 4030  W(1,J) = M(I1,J)
  405. 4040  W(2,J) = M(I2,J)
  406. 4050  W(3,J) = M(I3,J)
  407. 4060  W(4,J) = M(I4,J)
  408. 4070  W(5,J) = 25
  409. 4080  j=j+1:if j<5 goto 4030
  410. 4090  C = 0
  411. 4100  gosub scorehand
  412. 4110  V(Z9,7) = P
  413. 4120  IF P > P9 THEN P9 = P
  414. 4130  NEXT Z9
  415. 4140  J = 0
  416. 4150  i=1
  417. 4160  IF V(I,7) <> P9 THEN 4190
  418. 4170  J = J+ 1
  419. 4180  I(J) = I
  420. 4190  i=i+1:if i<16 goto 4160
  421. 4200  IF J > 1 goto 4230
  422. 4210  B9 = I(1)
  423. 4220  RETURN
  424. 4230  C9 = 5
  425. 4240  Z = 1
  426. 4250  GOTO 4410
  427. 4260  C9 = 8
  428. 4270  Z = 2
  429. 4280  GOTO 4410
  430. 4290  C9 = 7
  431. 4300  Z = 3
  432. 4310  GOTO 4410
  433. 4320  C9 = 11
  434. 4330  Z = 4
  435. 4340  GOTO 4410
  436. 4350  C9 = 1
  437. 4360  Z = 5
  438. 4370  GOTO 4410
  439. 4380  FOR WQ = 1 TO NT: B9 = INT(J*RND(1))+1: NEXT WQ
  440. 4390  B9 = I(B9)
  441. 4400  RETURN
  442. 4410  P9 = 0
  443. 4420  FOR I = 1 TO 15
  444. 4430  J(I) = 0
  445. 4440  NEXT I
  446. 4450  FOR I = 1 TO J
  447. 4460  FOR K = 1 TO 4
  448. 4470  L = V(I(I),K)
  449. 4480  IF M(L,4) <> C9 THEN 4500
  450. 4490  J(I) = J(I) + 1
  451. 4500  NEXT K
  452. 4510  IF J(I) > P9 THEN P9 = J(I)
  453. 4520  NEXT I
  454. 4530  K = 0
  455. 4540  FOR I = 1 TO J
  456. 4550  IF J(I) <> P9 THEN 4580
  457. 4560  K = K+ 1
  458. 4570  B9 = I(I)
  459. 4580  NEXT I
  460. 4590  IF K <> 1 THEN 4610
  461. 4600  RETURN
  462. 4610  ON Z GOTO 4260,4290,4320,4350,4380
  463. 4620  UPCARD:playnum=-1
  464. 4630  U = INT(38*RND(1)) + 14
  465. 4640  c$=c$(d(u,1)):gosub cardsplit:x=143:y=65:gosub card:gotoxy 14,7:           ?"up":gotoxy 12,8:?"card"
  466. 4650  i=1
  467. 4660  W(5,I)=D(U,I):i=i+1:if i<5 goto 4660
  468. 4670  T9 = W(5,4)
  469. 4680  IF W(5,4) <> 11 THEN 4770
  470. 4690  IF M = 0 THEN 4740
  471. 4700  gosub clrinst:?"2 points to me.":gosub pause
  472. 4710  S1 = S1+2:gosub pointup
  473. 4720  IF S1 >= 121 THEN 2160
  474. 4730  RETURN
  475. 4740  gosub clrinst:?" 2 points to you.":gosub pause
  476. 4750  S2 = S2+2:gosub pointup
  477. 4760  IF S2 > 121 THEN 2170
  478. 4770  RETURN
  479. 4780  SCOREHAND:
  480. 4790  P = 0
  481. 4800  IF C = 1 THEN 4870
  482. 4810  FOR I = 1 TO 4
  483. 4820  IF W(I,4) <> 11 THEN 4860
  484. 4830  IF W(I,3) <> W(5,3) THEN 4860
  485. 4840  P = P+1
  486. 4850  GOTO 4870
  487. 4860  NEXT I
  488. 4870  FOR I = 1 TO 3
  489. 4880  IF W(I,3) <> W(I+1,3) THEN 4970
  490. 4890  NEXT I
  491. 4900  IF C <> 0 THEN 4950
  492. 4910  P = P+4
  493. 4920  IF W(4,3) <> W(5,3) THEN 4970
  494. 4930  P = P+1
  495. 4940  GOTO 4970
  496. 4950  IF W(4,3) <> W(5,3) THEN 4970
  497. 4960  P = P+5
  498. 4970  FOR I = 1 TO 4
  499. 4980  FOR J = I+1 TO 5
  500. 4990  IF W(I,2)+W(J,2) <> 15 THEN 5010
  501. 5000  P = P+ 2
  502. 5010  NEXT J
  503. 5020  NEXT I
  504. 5030  FOR I = 1 TO 3
  505. 5040  FOR J = I+1 TO 4
  506. 5050  FOR K = J+1 TO 5
  507. 5060  IF W(I,2)+W(J,2)+W(K,2) <> 15 THEN 5080
  508. 5070  P = P+2
  509. 5080  NEXT K
  510. 5090  NEXT J
  511. 5100  NEXT I
  512. 5110  FOR I = 1 TO 2
  513. 5120  FOR J = I+1 TO 3
  514. 5130  FOR K = J+1 TO 4
  515. 5140  FOR L = K+1 TO 5
  516. 5150  IF W(I,2)+W(J,2)+W(K,2)+w(L,2)<> 15 THEN 5170
  517. 5160  P = P+2
  518. 5170  NEXT L
  519. 5180  NEXT K
  520. 5190  NEXT J
  521. 5200  NEXT I
  522. 5210  S = 0
  523. 5220  i=1
  524. 5230  S = S+W(I,2):i=i+1:if i<6 goto 5230
  525. 5240  IF S <> 15 THEN 5260
  526. 5250  P = P+2
  527. 5260  FOR I = 1 TO 13
  528. 5270  J(I) = 0
  529. 5280  NEXT I
  530. 5290  FOR I = 1 TO 5
  531. 5300  J = W(I,4)
  532. 5310  J(J) = J(J)+1
  533. 5320  NEXT I
  534. 5330  i=1
  535. 5340  ON J(I)+1 GOTO 5380,5380,5370,5360,5350
  536. 5350  P = P+6
  537. 5360  P = P+4
  538. 5370  P = P+2
  539. 5380  i=i+1:if i<14 goto 5340
  540. 5390  FOR I = 1 TO 5
  541. 5400  FOR J = 1 TO 5
  542. 5410  IF W(I,4) <= W(J,4) THEN 5450
  543. 5420  K = W(I,4)
  544. 5430  W(I,4) = W(J,4)
  545. 5440  W(J,4) = K
  546. 5450  NEXT J
  547. 5460  NEXT I
  548. 5470  D = W(1,4)-Q(I,1)
  549. 5480  FOR I = 1 TO 11
  550. 5490  FOR J = 1 TO 5
  551. 5500  Q(I,J) = Q(I,J)+D
  552. 5510  NEXT J
  553. 5520  NEXT I
  554. 5530  FOR I = 1 TO 11
  555. 5540  FOR J = 1 TO 5
  556. 5550  IF W(J,4) <> Q(I,J) THEN 5590
  557. 5560  NEXT J
  558. 5570  P = P+Q(I,6)
  559. 5580  RETURN
  560. 5590  NEXT I
  561. 5600  FOR L = 1 TO 2
  562. 5610  D = W(L,4)-R(1,1)
  563. 5620  FOR I = 1 TO 4
  564. 5630  FOR J = 1 TO 4
  565. 5640  R(I,J) = R(I,J)+D
  566. 5650  NEXT J
  567. 5660  NEXT I
  568. 5670  FOR I = 1 TO 4
  569. 5680  FOR K = 1 TO 4
  570. 5690  IF W(K+L-1,4) <> R(I,K) THEN 5730
  571. 5700  NEXT K
  572. 5710  P = P+R(I,5)
  573. 5720  RETURN
  574. 5730  NEXT I
  575. 5740  NEXT L
  576. 5750  FOR L = 1 TO 3
  577. 5760  D = W(L,4)-S(1)
  578. 5770  i=1
  579. 5780  s(i)=s(i)+d:i=i+1:if i<4 goto 5780
  580. 5790  FOR I = 1 TO 3
  581. 5800  IF W(L+I-1,4) <> S(I) THEN 5840
  582. 5810  NEXT I
  583. 5820  P = P+ S(4)
  584. 5830  RETURN
  585. 5840  NEXT L
  586. 5850  RETURN
  587. 5860  SHUFFLE:randomize(0)
  588. 5870  crib=0:gosub clrbd:humnum=0:comnum=0
  589. 5880  i=1
  590. 5890  i(i)=0:i=i+1:if i<53 goto 5890
  591. 5900  i=1
  592. 5910  J = INT(52*RND(1))+1
  593. 5920  IF I(J) <> 0 THEN 5910
  594. 5930  D(I,1) = J
  595. 5940  D(I,3) = INT((J-1)/13)+1
  596. 5950  D(I,4) = J-13*INT((J-1)/13)
  597. 5960  UY = 10: IF D(I,4) < UY THEN UY = D(I,4)
  598. 5970  D(I,2) = UY
  599. 5980  I(J) = 1
  600. 5990  i=i+1:if i<53 goto 5910
  601. 6000  RETURN
  602. 6010  CUT: gosub clrbd
  603. 6020  gosub spread:gosub clrinst:?"Cut:click under a card"
  604. 6030  gosub getspread:i=cardnum:i1=d(i,1):c$=c$(i1):gosub cardsplit:y=30
  605. 6040  x=71:gosub card:gosub clrinst:?"Now I'll cut.":gosub pause
  606. 6050  j=int(52*rnd)+1:if j=i goto 6050
  607. 6060  j1=d(j,1):c$=c$(j1):gosub cardsplit:x=125:y=75:gosub card
  608. 6070  IF D(I,4) > D(J,4) THEN 6140
  609. 6080  IF D(J,4) > D(I,4) THEN 6110
  610. 6090  gosub clrinst:?"Tie. Cut again":gosub pause:goto 6010
  611. 6110  M = 0
  612. 6120  gosub pause:RETURN
  613. 6140  M = 1
  614. 6150  gosub pause:RETURN
  615. 6160  DEAL:
  616. 6170  IF M = 0 THEN 6200
  617. 6180  gotoxy 7,6:?spc(10):gotoxy 7,11:?"You Deal."
  618. 6190  GOTO 6210
  619. 6200  gotoxy 7,11:?spc(10):gotoxy 7,6:?"I Deal."
  620. 6210  M = 1 - M
  621. 6220  z = 1 - M
  622. 6230  FOR I = 1 TO 6
  623. 6240  K = 2*I-z
  624. 6250  L = 2*I-M
  625. 6260  j=1
  626. 6280  M(I,J) = D(K,J)
  627. 6300  Y(I,J) = D(L,J)
  628. 6310  j=j+1:if j< 5 goto 6280
  629. 6320  x=16+((i-1)*36):y=111:c$=c$(y(i,1)):gosub cardsplit:gosub card
  630. 6330  x=16+((i-1)*36):y=12:gosub back
  631. 6340  NEXT I:gosub gobox
  632. 6350  RETURN
  633. 6360  DATA 1,2,3,4,5,6,0,1,2,3,5,4,6,0,1,2,3,6,4,5,0
  634. 6370  DATA 1,2,4,5,3,6,0,1,2,4,6,3,5,0,1,2,5,6,3,4,0
  635. 6380  DATA 1,3,4,5,2,6,0,1,3,4,6,2,5,0,1,3,5,6,2,4,0
  636. 6390  DATA 1,4,5,6,2,3,0,2,3,4,5,1,6,0,2,3,4,6,1,5,0
  637. 6400  DATA 2,3,5,6,1,4,0,2,4,5,6,1,3,0,3,4,5,6,1,2,0
  638. 6410  DATA 1,1,1,2,3,9,1,1,2,2,3,12,1,1,2,3,3,12
  639. 6420  DATA 1,1,2,3,4,8,1,2,2,2,3,9,1,2,2,3,3,12
  640. 6430  DATA 1,2,2,3,4,8,1,2,3,3,3,9,1,2,3,3,4,8
  641. 6440  DATA 1,2,3,4,4,8,1,2,3,4,5,5
  642. 6450  DATA 1,1,2,3,6,1,2,2,3,6,1,2,3,3,6,1,2,3,4,4
  643. 6460  DATA 1,2,3,3
  644. 6470  DATA " A"," 2"," 3"," 4"," 5"," 6"," 7"," 8"
  645. 6480  DATA " 9","10", " J", " Q"," K"
  646. 6490  END
  647. 6500  INIT:
  648. 6510  DIM D(52,4),C$(52),I(52),W(5,4)
  649. 6520  DIM M(6,4),Y(6,4),C(4,4),S(4)
  650. 6530  DIM V(15,7),Q(11,6),R(4,5),J(52),cp(6)
  651. 6540  REPEAT:FOR X = 1 TO 15: FOR Y = 1 TO 7
  652. 6550  READ V(X,Y): NEXT Y: NEXT X
  653. 6560  FOR X = 1 TO 11: FOR Y = 1 TO 6
  654. 6570  READ Q(X,Y): NEXT Y: NEXT X
  655. 6580  FOR X = 1 TO 4: FOR Y = 1 TO 5
  656. 6590  READ R(X,Y): NEXT Y: NEXT X
  657. 6600  read s(1):read s(2):read s(3): read s(4)
  658. 6610  i=1
  659. 6620  READ C$
  660. 6630  C$(I) = LEFT$(C$,4) + " of S"
  661. 6640  C$(I+13) = LEFT$(C$,4) + " of D"
  662. 6650  C$(I+26) = LEFT$(C$,4) + " of Hearts"
  663. 6660  C$(I+39) = LEFT$(C$,4) + " of C"
  664. 6670  i=i+1:if i<14 goto 6620
  665. 6680  color 4,0,1,1,1
  666. 6690  gotoxy 0,0:?"My Hand":gotoxy 0,17:?"Player's Hand";
  667. 6700  gotoxy 0,7:?"C":?"R":?"I":?"B":color 1,0,1,1,1
  668. 6710  return
  669. ə6690  gotoxy 0,0:?"My Hand":gotoxy 0,17:?"Player's Hand";
  670. 670